perm filename IODEFS.SAI[4,KMC] blob sn#180019 filedate 1975-10-04 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	DEFINE  TAB="'11", LF="'12", FF="'14", CR="'15", SP="'40",
C00006 00003	INTEGER PROC ROUND(VALUE REAL R)  RETURN(R + .5)
C00009 ENDMK
C⊗;
DEFINE  TAB="'11", LF="'12", FF="'14", CR="'15", SP="'40",
 	ALT="'175", BS="'177", ↓="& CR & LF", ∂="& "" "" &";

DEFINE	α="COMMENT", TIL="STEP 1 UNTIL", LN="LENGTH", PROC="PROCEDURE";

INTEGER INCH1,INCH2,OUCH1,OUCH2,CNT,BRK,EOF,FLAG;	α INPUT/OUTPUT GLOBALS;
STRING  FILE;

DEFINE	DSKI="OPEN(INCH←GETCHAN,""DSK"",0,4,0,CNT←200,BRK,EOF)",
	DSKO="OPEN(OUCH←GETCHAN,""DSK"",0,0,4,0,0,EOF)",
	FILI="LOOKUP(INCH,IFILE,FLAG)",
	FILO="ENTER(OUCH,OFILE,FLAG)",
	LPTO="OPEN(OUCH←GETCHAN,""LPT"",0,0,2,0,0,EOF←0)",
	TTYI="OPEN(INCH←GETCHAN,""TTY"",1,2,0,CNT←200,BRK,EOF)",
	TTYO="OPEN(OUCH←GETCHAN,""TTY"",1,0,2,0,0,EOF)";

FORWARD STRING PROC GET_A_STRING(VALUE STRING QUESTION);

PROC FILIN(VALUE STRING IFILE; REFERENCE INTEGER INCH);
	BEGIN
	DSKI;	FILI;
	WHILE FLAG DO
		BEGIN
		LODED(IFILE);
		IFILE ← GET_A_STRING("Try again");
		FILI;
		END;
	END;

PROC FINDFIL(VALUE STRING IFILE; REFERENCE INTEGER INCH);
	BEGIN DSKI; FILI; END;

PROC FILOUT(VALUE STRING OFILE; REFERENCE INTEGER OUCH);
	BEGIN DSKO; FILO; END;

DEFINE	BREAK_LINE="SETBREAK(1, LF, CR & FF, ""ISN"")",
	BREAK_BLANK="SETBREAK(2, SP, NULL, ""ISN"")",
	BREAK_TAB="SETBREAK(3, TAB, NULL, ""ISN"");
		   SETBREAK(4, NULL, TAB, ""ISN"")",
	BREAK_LISP="SETBREAK(5, "")"", NULL, ""IAN"");
		    SETBREAK(6, "" )"", NULL, ""IRN"")",
	BREAK_EXT="SETBREAK(7, "" .["", NULL, ""ISN"")",
	BREAK_COMMA="SETBREAK(8, "","", NULL, ""ISN"")";

PROC EAT_DIR(INCH);
	BEGIN
	STRING TEMP;
	DO TEMP ← INPUT(INCH, 1) UNTIL EQU(TEMP, "C⊗;");
	END;

DEFINE	IN_LINE="INPUT(INCH1,1)";
PROC OUT_LINE(VALUE STRING LINE); OUT(OUCH1, LINE ↓);

STRING BLANKS;		INTEGER I;

STRING PROC LEFTJ(VALUE INTEGER L; VALUE STRING S);
	RETURN(IF LN(S)<L THEN S&BLANKS[1 TO L-LN(S)] ELSE S[1 TO L]);

STRING PROC RIGHTJ(VALUE INTEGER L; VALUE STRING S);
	RETURN(IF LN(S)<L THEN BLANKS[1 TO L-LN(S)]&S  ELSE S[1 TO L]);

STRING PROC CENTER(VALUE INTEGER L; VALUE STRING S);
	RETURN(IF LN(S)<L THEN BLANKS[1 TO (L-LN(S))DIV 2]&
		S & BLANKS[1 TO (L-LN(S)+1)DIV 2] ELSE S[1 TO L]);

INTEGER PROC ROUND(VALUE REAL R);  RETURN(R + .5);

INTEGER PROC GET_AN_INT(VALUE STRING QUESTION);
	BEGIN
	STRING ANSWER;
	OUTSTR(QUESTION ∂ "?  ");
	ANSWER ← INCHWL;
	RETURN(INTSCAN(ANSWER, BRK));
	END;

STRING PROC GET_A_STRING(VALUE STRING QUESTION);
	BEGIN
	OUTSTR(QUESTION ∂ "?" ↓);
	RETURN(INCHWL);
	END;

α  0 = identical
   n = A < B, first difference in position "n"
  -n = A > B, first difference in position "n";

INTEGER PROC ALPHA(VALUE STRING A, B);
	BEGIN
	INTEGER AVAL, BVAL, COUNT;
	COUNT ← 1;
	WHILE (AVAL ← LOP(A)) = (BVAL ← LOP(B)) DO
		IF AVAL = 0 THEN RETURN(0) ELSE COUNT ← COUNT + 1;
	RETURN(IF(AVAL < BVAL) THEN COUNT ELSE -COUNT);
	END;

STRING PROC CAR(VALUE STRING LINE);
	RETURN(SCAN(LINE, 3, BRK));

STRING PROC CDR(VALUE STRING LINE);
	BEGIN
	STRING TEMP;
	TEMP ← SCAN(LINE, 3, BRK);
	RETURN(SCAN(LINE, 4, BRK));
	END;

INTEGER PROC SCAN_COORDINATE(REFERENCE STRING LINE; VALUE INTEGER NEG, POS);
	BEGIN
	INTEGER COORD, ORIENT;
	COORD ← INTSCAN(LINE, BRK);
	ORIENT ← LOP(LINE);
	ORIENT ← LOP(LINE);
	IF ORIENT ≥ "a" THEN ORIENT ← ORIENT - 32;
	IF ORIENT = NEG THEN COORD ← - COORD
	ELSE IF ORIENT ≠ POS THEN OUTSTR("Peculiar coordinate:" ∂ LINE ↓);
	RETURN(COORD);
	END;

INTEGER PROC SCAN_LONG(REFERENCE STRING LINE);
	RETURN(SCAN_COORDINATE(LINE, "W", "E"));

INTEGER PROC SCAN_LAT(REFERENCE STRING LINE);
	RETURN(SCAN_COORDINATE(LINE, "S", "N"));